perm filename CONNEW.F4[2,LCS] blob sn#153751 filedate 1975-04-04 generic text, type T, neo UTF8
00100	C  *******CONVERTS FROM MAGTAPE OR 2314 TO UDP OR 2314  *******
00200	C  DEC 17,1970  ********* CONVERTS 18 (AND 12) BIT .DMD FILES  ****
00300	C   CONVERTS .DMD FILES WRITTEN WITH RCDFLG=1; OR BIGBIT=1;(or =2;)
00400	C   LOAD WITH CVTIO.REL AND CVTALC.MAC
00500	C TYPE 'X' IF FINAL NAME UNKNOWN OR IF DATA GOES BEYOND CURRENT TAPE.
00600	C 1ST NAME OF EACH PAIR TYPED BY COMPUTER IS BASED ON NAME #1 YOU TYPED.
00700	C   2ND IS ACTUAL NAME OF FILE.
00800	C   IF NO MAXAMP IS TYPED AFTER NAME #1, IT WILL BE REQUESTED LATER.
00900	C TO BACK UP TYPE '-1'. 'REWIND' MAY BE TYPED FOR 'MTA0?' OR 'NAME #1'.
01000	C   USE 'TAPMUS' TO ADVANCE TAPE IF NEEDED.
01100		DIMENSION JSB(128),IBOTT(4096)
01300	100	FORMAT(' TYPE NAME #1'/)
01400	200	FORMAT(' TYPE FINAL NAME'/)
01500	250	FORMAT(A1)
01600	300	FORMAT(2XA5,2XI7,I9)
01800	400	FORMAT(A5,2I)
01900	450	FORMAT(' READ FROM MTA0?'/)
02000	500	FORMAT(I,' WORDS,   FACTOR=',F6.3,',  MAXAMP=',I4/)
02100	600	FORMAT(' MORE??'/)
02200	700	FORMAT(' TYPE MAXAMP'/)
02300	800	FORMAT(4I)
02400		EQUIVALENCE (JSB(2),JSB2),(JSB(3),JSB3),(JSB(4),JSB4)
02500	  	MUSIC='MUSIC'
03000	CC***	CALL PUTMUS(MUSIC)
03050		PUTM=-1
03100		FACTOR=1.
03300		N=9000
03400		JUDP=4
03500	C   GARPLY READS 4*1024 WDS.
03600		JSIZE=1024
04300	101	KSIZE=JSIZE
04400		MX=0
04500		KCNT=0
04600		IX=0
04700		JA=1
04800	440	TYPE 450
04850	C ANSWERS: R=REWIND AND YES,  A=ADVANCE TAPE AND LIST HIGHEST AMP.(SLOW!)
04875	C    Y=YES,  BLANK=NO
04900		ACCEPT 250,TAPE
04910		MAX=-1
04920		IF(TAPE.NE.'A')GO TO 441
04930		MAX=0
04940		ITOP=0
04950		GO TO 442
05000	441	IF(TAPE.NE.'R')GO TO 54
05100		REWIND 16
05200	442	TAPE='Y'
05300	54	TYPE 100
05400		JNM='AAAAA'
05500		ACCEPT 400,NAME,MAXAMP
05600	  	IF(MAXAMP.EQ.0)MAXAMP=MX
05700		IF(NAME.EQ.'-1')GO TO 440
05800		IF(NAME.EQ.'NO')GO TO 1201
05900	C   CAN TYPE 'NO' IF MISTAKE ON 'MORE' EARLIER.
06000		IF(NAME.EQ.' ')NAME='MUSAA'
06100	2	JNM=JNM+((NAME-JNM)/256*256)
06200		KNM=JNM
06300	C   AUTOMATICALLY SETS BASIC NAME TO 'A' ENDING. 12-BIT SOUND NOT NORMALIZED.
06400	1002	TYPE 200
06500		ACCEPT 400,NM2,KSKIP
06600		IF(NM2.EQ.'-1')GO TO 54
06700		IF(NM2.EQ.' ')NM2=NAME
06800		IF(TAPE.NE.'Y')GO TO 7077
06900		IF(MAXAMP.NE.0.OR.MAX.EQ.0)GO TO 2710
06910	C  MAXAMP WAS GIVEN OR WE'RE LOOKING FOR IT.
07000		TYPE 700
07100		ACCEPT 800,MAXAMP
07200		IF(MAXAMP)GO TO 54
07210	C  -1=BACKUP HERE
07300		IX=0
07400	2710	IF(NM2.EQ.' ')NM2=NAME
07500	1710	CALL GETTAP
07600	1810	CALL INTAPE(JSB(1),128)
07700		IF(JSB(1))GO TO 1202
07800		TYPE 300,JSB3
07900		IF(IX.OR.JSB2.EQ.3)GO TO 2022
08000		IF(MAXAMP.EQ.0)MAXAMP=2040
08100		GO TO 199
08200	7077	IF(MAXAMP.NE.0)GO TO 4022
08300		CALL GETFIL(NM2)
08400		CALL FASTIN(JSB(1),128)
08500		IF(JSB2.EQ.3)GO TO 4022
08600		JSC=JSB(1)
08700	6066	CALL FASTIN(IBOTT(1),JSC)
08800		IF(IBOTT(JSC).EQ.0)GO TO 6066
08900	     	MAXAMP=IABS(IBOTT(JSC))
09000	4022	IF(N)GO TO 710
09100		N=-2
09200		IF(JSB2.EQ.3)GO TO 710 
09300	199	FACTOR=2040./MAXAMP
09400	    	MX=MAXAMP
09500		IX=-1
09600		KSIZE=3*JSIZE/2
09700		IF(TAPE.EQ.'Y')GO TO 2022
09800	C  AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
09900	710	IF(TAPE.EQ.'Y')GO TO 1810
10000	   	CALL GETFIL(NAME)
10100	810	CALL FASTIN(JSB(1),128)
10200		IF(JSB2.EQ.3)IX=0
10300	2022	JSC=JSB(1)
10400	1022	IF(JA.GT.KSIZE)GO TO 17
10500	610	IF(TAPE.NE.'Y')CALL FASTIN(IBOTT(JA),JSC)
10600	    	IF(TAPE.EQ.'Y')CALL INTAPE(IBOTT(JA),JSC)
10700	C   LAST WORD IS THROWN AWAY.
10800		JA=JA+JSC-1
10900		JC=IBOTT(JA)
11000		IF(JC)5,1022,6
11100	5	JA=JA-IBOTT(JA-1)
11200	6	TYPE 300,NAME,JC,KCNT
11210		IF(JC)JC=-JC
11220		IF(JC.GT.ITOP)ITOP=JC
11230	C FINDS MAXAMP ON TAPE FILES.
11300		NAME=NAME+2
11400		IF(NAME.LE.JNM+50)GO TO 27
11500		JNM=JNM+256
11600		IF(JNM.LE.KNM+6400)GO TO 1017
11700		KNM=JNM+26112
11800		JNM=KNM
11900	C   RAISES 'AAAZA' TO 'AABAA'
12000	1017	NAME=JNM
12100	27	IF(NAME.LE.NM2)GO TO 710
12110	1202	IF(MAX)GO TO 1203
12120		TYPE 500,KCNT,FACTOR,ITOP
12130	C TYPES MAXAMP OF TAPE FILES.
12140		GO TO 101
12150	
12200	1203	TYPE 600
12300		ACCEPT 400,NAME
12400		IF(NAME.EQ.'YES'.OR.NAME.EQ.'Y')GO TO 440
12500	1201	NM2=NAME-1
12600	17	JC=JA-1
12700		IF(JC.LT.KSIZE)GO TO 23
12800	10	IF(IX.AND.MAX)CALL NORM(IBOTT(1),KSIZE,FACTOR)
12900		LSIZE=KSIZE
13000		JMP=-1
13100	32	KCNT=KCNT+JSIZE
13110		IF(PUTM)CALL PUTMUS(MUSIC)
13210		PUTM=0
13300		IF(MAX)CALL FSTMUS(IBOTT(1),JSIZE)
13400		IF(JMP)7,8,9
13700	7	JC=JC-LSIZE
13800		DO 12 K=1,JC
13900	12	IBOTT(K)=IBOTT(K+LSIZE)
14000		JA=JC+1
14100		IF(JC.GT.KSIZE)GO TO 10
14200		IF(NAME.LE.NM2)GO TO 610
14300	23	IF(IX.EQ.0)GO TO 43
14400		CALL NORM(IBOTT(1),JC,FACTOR)
14500		JC=JC*2/3
14550	43	IF(JC)JC=0
14575	C ****** WHY SHOULD IT EVER BE NEG.  7/74
14600		DO 13 K=JC+1,JSIZE
14700	13	IBOTT(K)=0
14800		JMP=0
14900		GO TO 32
15000	8 	DO 14 K=1,JSIZE
15100	14	IBOTT(K)=0
15200		JMP=1
15300		GO TO 32
15400	9	K=KCNT/JSIZE
15500		L=K-(K/JUDP)*JUDP
15600		IF(L.EQ.0)GO TO 3222
15700		DO 4222 K=1,JSIZE
15800	4222	IBOTT(K)=0
15900		DO 6222 K=1,L
16300	6222	CALL FSTMUS(IBOTT(1),JSIZE)
16500		KCNT=KCNT+L*JSIZE
16600	3222	CALL FINMUS
16800	7222	TYPE 500,KCNT,FACTOR,MAXAMP
16900		END